home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
windows
/
wnfond13.zip
/
WINFOND.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-08-16
|
4KB
|
179 lines
program winfond;
{$R WINFOND.RES}
{$I-}
{$M 8192,8192}
uses strings,win31,winprocs,wintypes,Windos;
CONST NBIM = 200;
var Tablo : array[1..NBIM] of string[120];
valeur,max,compt : integer;
erreur,fichier,nom,actu,comp1,comp2 : string;
fin : boolean;
f : text;
asciiz,asciiz2,asciiz3 : array[0..80] of char;
ou,au,texte : Pchar;
chaine : string[80];
size : word;
label stop;
Function majuscule(phrase : string) : string;
var texte : array[0..255] of char;
pointe : Pchar;
begin
pointe:=@texte;
StrPCopy(pointe,phrase);
majuscule:=Strpas(AnsiUpper(pointe));
end;
Procedure AllInRep(chaine : string; var i : integer);
var result : TSearchRec;
recherche,pointe : Pchar;
test : array[1..120] of Char;
chemin : string;
Begin
recherche:=@test;
chemin:=copy(chaine,1,length(chaine)-5);
StrPcopy(recherche,chaine);
FindFirst(recherche,faAnyFile,result); {recherche du premier .BMP}
If DosError=0 then
begin
pointe:=@result.name;
Tablo[i]:=chemin+StrPas(pointe);
end;
while DosError = 0 do {arrΩt en cas d'erreur ou en cas de 18 -> Plus de fichiers}
begin
FindNext(result); {recherche du .BMP suivant}
if DosError = 0 then
begin
i:=i+1;
pointe:=@result.name;
Tablo[i]:=chemin+StrPas(pointe); {Tablo[i] se remplit avec les noms trouvΘs}
end;
end;
If (DosError<>0) and (DosError<>18) Then
erreur:='Erreur dans l''utilisation de *.BMP';
end;
Procedure Lire(fichier : string);
var f: text;
i : integer;
chaine : string;
test : string;
begin
i:=0;
Assign(f,fichier);
Reset(f);
chaine:='';
Repeat
i:=i+1;
Readln(f,chaine);
test:=copy(chaine,length(chaine)-4,5);
if (majuscule(test)='*.BMP')
then AllInRep(chaine,i) {AllInRep permet de trouver tous les .BMP d'un rep.}
else Tablo[i]:=chaine;
until Eof(f);
Close(f);
end;
{
La fonction IsAFile vΘrifie qu'il
s'agit d'un fichier en l'ouvrant
et en vΘrifiant que tout va bien
(ioresult=0)
}
Function IsAFile(chaine : string) : boolean;
var fich : file;
begin
IsAFile:=FALSE;
assign(fich,chaine);
if ioresult<>0
then IsAFile:=FALSE
else
begin
reset(fich,1);
if ioresult<>0
then
IsAFile:=FALSE
else
begin
IsAFile:=TRUE;
close(fich);
end;
end;
end;
Function IsBMP(chaine : string) : boolean;
const BMP=19778;
var fich : file;
tipe : word;
taille : longint;
begin
IsBMP:=FALSE;
assign(fich,chaine);
if ioresult<>0
then IsBMP:=FALSE
else
begin
reset(fich,1);
if ioresult<>0
then
IsBMP:=FALSE
else
begin
Blockread(fich,tipe,2);
if (tipe=BMP)
and (pos(' ',chaine)=0)
then Isbmp:=TRUE
else IsBMP:=FALSE;
close(fich);
end;
end;
end;
BEGIN
randomize;
for compt:=1 to NBIM do
Tablo[compt]:='';
fichier:='';
valeur:=-1;
erreur:='RIEN';
if paramcount=1
then fichier:=paramstr(1)
else begin
if paramcount>1 then erreur:='Too many parameters';
if paramcount<1 then erreur:='Not enough parameters';
goto stop;
end;
if IsAFile(fichier)
then Lire(fichier)
else begin erreur:='File not found: "'+fichier+'"'; goto stop; end;
for compt:=1 to NBIM do
if Tablo[compt]<>'' then max:=compt;
for compt:=1 to max do
fin:=FALSE;
{recupere le nom precedent et le stocke dans actu}
comp1:='Franτois CREVOLA'; comp2:='';
ou:=@asciiz; au:=@asciiz2;
StrPCopy(ou,comp1); StrPCopy(au,comp2);
{ returned---\ }
GetProfileString('Desktop','Wallpaper',ou,au,80);
actu:=strpas(au);
repeat
Nom:=tablo[random(max)+1];
until (nom<>actu);
if (IsBMP(nom)=FALSE) then begin erreur:='"'+nom+'" is not a BMP'; goto stop; end else erreur:='RIEN';
ou:=@asciiz;
au:=@asciiz2;
StrPCopy(ou,nom);
StrPCopy(au,actu);
WriteProfileString('Desktop', 'WallPaper', ou);
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,au,0);
stop:
texte:=@asciiz3;
StrPcopy(texte,erreur+chr(13)+'( Help -> WINFOND.HLP )');
if (erreur<>'RIEN') then valeur:=Messagebox(0,texte,'Winfond v1.3 - (c) Franτois CREVOLA 1996',mb_IconStop OR mb_OK);
END.